home *** CD-ROM | disk | FTP | other *** search
- {
- BRIAN PAPE
-
- Ok, here's about 45 minutes of sweating, trying to read some pitifull SB
- reference. This is about as far as I've gotten trying to make the SB
- make some noise that is actually a note, not just a buzz... If anyone
- can do ANYTHING at ALL with this, please tell me.
-
- This program is not Copyright (c)1993 by Brian Pape.
- written 4/13/93
- It is 100% my code with nothing taken from anyone else. If you can use it in
- anyway, great. I should have the actual real version done later this summer
- that is more readable. The .MOD player is about half done, pending the
- finishing of the code to actually play the notes (decoder is done).
- My fido address is 1:2250/26
- }
- program sb;
- uses
- crt;
- const
- on = true;
- off = false;
- maxreg = $F5;
- maxch = 10;
-
- note_table : array [0..12] of word =
- ($000,$16b,$181,$198,$1b0,$1ca,$1e5,$202,$220,$241,$263,$287,$2ae);
- key_table : array [1..12] of char =
- 'QWERTYUIOP[]';
- voicekey_table : array [1..11] of char =
- '0123456789';
- type
- byteset = set of byte;
-
- var
- ch : char;
- channel : byte;
- ch_active : byteset;
- lastnote : array [0..maxch] of word;
-
-
- procedure writeaddr(b : byte); assembler;
- asm
- mov al, b
- mov dx, 388h
- out dx, al
- mov cx, 6
-
- @wait:
- in al, dx
- loop @wait
- end;
-
- procedure writedata(b : byte); assembler;
- asm
- mov al, b
- mov dx, 389h
- out dx, al
- mov cx, 35h
- dec dx
-
- @wait:
- in al, dx
- loop @wait
- end;
-
- procedure sb_reset;
- var
- i : byte;
- begin
- for i := 1 to maxreg do
- begin
- writeaddr(i);
- writedata(0);
- end;
- end;
-
- procedure sb_off;
- begin
- writeaddr($b0);
- writedata($11);
- end;
-
- { r=register,d=data }
- procedure sb_out(r, d : byte);
- begin
- writeaddr(r);
- writedata(d);
- end;
-
- procedure sb_setup;
- begin
- sb_out($20, $01);
- sb_out($40, $10);
- sb_out($60, $F0);
- sb_out($80, $77);
- sb_out($A0, $98);
- sb_out($23, $01);
- sb_out($43, $00);
- sb_out($63, $F0);
- sb_out($83, $77);
- sb_out($B0, $31);
- end;
-
- procedure disphelp;
- begin
- clrscr;
- writeln;
- writeln('Q:C#');
- writeln('W:D');
- writeln('E:D#');
- writeln('R:E');
- writeln('T:F');
- writeln('Y:F#');
- writeln('U:G');
- writeln('I:G#');
- writeln('O:A');
- writeln('P:A#');
- writeln('[:B');
- writeln(']:C');
- writeln('X:Quit');
- writeln;
- end;
-
- procedure sb_note(channel : byte; note : word; on : boolean);
- begin
- sb_out($a0 + channel, lo(note));
- sb_out($b0 + channel, ($20 * byte(on)) or $10 or hi(note));
- end;
-
- procedure updatestatus;
- var
- i : byte;
- begin
- gotoxy(1,16);
- for i := 0 to maxch do
- begin
- if i in ch_active then
- textcolor(14)
- else
- textcolor(7);
- write(i : 3);
- end;
- end;
-
- begin
- sb_reset;
- sb_out(1, $10);
- sb_setup;
- disphelp;
- channel := 0;
- ch_active := [0];
- repeat
- updatestatus;
- ch := upcase(readkey);
- if pos(ch, key_table) <> 0 then
- begin
- lastnote[channel] := note_table[pos(ch, key_table)];
- sb_note(channel, lastnote[channel], on);
- end
- else
- if pos(ch, voicekey_table) <> 0 then
- begin
- channel := pred(pos(ch,voicekey_table));
- if channel in ch_active then
- ch_active := ch_active - [channel]
- else
- ch_active := ch_active + [channel];
- if not (channel in ch_active) then
- sb_note(channel,lastnote[channel],off)
- else
- sb_note(channel,lastnote[channel],on);
- end;
- until ch = 'X';
- sb_off;
- end.
-